home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMIGATAX / AMIGATAX.ADF / Tax89 < prev    next >
Text File  |  1990-03-02  |  12KB  |  482 lines
  1. REM tax89v1.0 feb 28/90
  2. DATA = ontario tax return =,$1989
  3. DATA .....jim butterfield..,c0;0
  4. DATA ====page 1====,c0
  5. DATA income from employmnt,#1;z2;i2
  6. DATA pension income,i2
  7. DATA family allowance,i2
  8. DATA divds tax cdn corpns,#3;i2
  9. DATA interest,i2
  10. DATA other income,i2
  11. DATA total income,#5;c3;s2
  12. DATA ====step 3====,c0
  13. DATA total income,c3;v5
  14. DATA reg pension contr,z3;i3
  15. DATA union/prof dues,i3
  16. DATA carrying charges,i3
  17. DATA other deductions,i3
  18. DATA total deductions,#6;c4;s3
  19. DATA net income,#7;c4;v5-v6
  20. DATA total dedns net inc,z3;i3
  21. DATA taxable income,#8;c4;v7-s3
  22. DATA ====step 4====,c0
  23. DATA personal credit,z3;c3;6066
  24. DATA age credit,i3[3272
  25. DATA credit for spouse,i3[5055
  26. DATA credit for children,i3
  27. DATA cpp contributions,i3[525
  28. DATA uic contributions,i3[613.6
  29. DATA total medical expnses,#13;i2
  30. DATA ..less 3% n.i.,#14;(v13>0);v7%3[1517;c2
  31. DATA allowable medical exp,(v13>0);v13-v14]0;c3
  32. DATA other credits,i3
  33. DATA line 335,#9;c4;s3[v8:REM guide confusing
  34. DATA tax credits,#10;z4;c4;v9%17
  35. DATA charitable donations,#11;i2
  36. DATA credit at 17%,(v11>0);c4;v11[250%17
  37. DATA credit at 29%,(v11>250);c4;v11-250]0%29
  38. DATA total tax credits,#12;s4;c4
  39. DATA =====schedule  1===,c0
  40. DATA brckt,#15;v8;x;55605;27803;0
  41. DATA ..on first,v15;c1
  42. DATA ..tax is,#16;c2;y;11955;4726;0
  43. DATA ..on remaining,#17;c1;v8-v15
  44. DATA ..tax at percent..,#18;c1;y;29;26;17
  45. DATA ..gives,#19;c2;v17%v18
  46. DATA total,#20;c3;v16+v19
  47. DATA total nr tax credit,v12;z3;c3
  48. DATA divd tax credit,c3;v3%40/3[v20
  49. DATA total credits,#21;c4;s3
  50. DATA basic federal tax,#22;c4;v20-v21]0
  51. DATA forgn tax deductions,#23;i3
  52. DATA federal tax,#24;c4;v22-v23
  53. DATA surtax at 4%,z3;(v22>0);c3;v22%4
  54. DATA surtax at 1.5%,(v22>15000);c3;v22-15000]0%1.5
  55. DATA indiv surtax payable,#28;c4;s3
  56. DATA ===ontario tax===,0
  57. DATA basic ontario tax,#30;c3;v22%52
  58. DATA ontario surtax,#31;c3;v30-10000]0%10
  59. DATA adjusted tax,#32;c4;v30+v31
  60. DATA tax reduction,#35;c3;0-v32*2+450]0[v32
  61. DATA ontario tax,#36;c4;v32-v35
  62. DATA =ontario tax credits=,c0
  63. DATA ontario tax credits,#50;i4
  64. DATA ..do form t1c(ont)..,(v50>0);c0;0
  65. DATA ..spouse incm needed..,(v50>0);c0;0
  66. DATA ===step 5===,c0
  67. DATA federal tax,c4;v24
  68. DATA federal tax credits,#51;i3
  69. DATA fed tax line 417,#52;c4;v24-v51
  70. DATA indiv surtax payable,c4;v28
  71. DATA net federal tax,#53;c4;v52+v28
  72. DATA ontario tax payable,#54;c3;v36
  73. DATA total payable,#55;c4;v53+v54
  74. DATA child tax credit,z3;i3
  75. DATA fed sales tax credit,i3
  76. DATA ....complete sched 7...,(s3>0);c0;0
  77. DATA ..spouse incm needed..,(s3>0);c0;0
  78. DATA ontario tax credits,c3;v50
  79. DATA tax deducted pr slips,i3
  80. DATA other credits,i3
  81. DATA total credits,#58;c4;s3
  82. DATA x,#59;v55-v58;(v58>v55);v58-v55
  83. DATA x,$;----------
  84. DATA * no balance *,#60;1;(v59<1);c0;0
  85. DATA x,#61;v60;(v58>v55);2*v60
  86. DATA * refund due *,(v61=2);c2;v59
  87. DATA * balance payable *,(v61=1);c2;v59
  88. DATA end,end,end
  89.  
  90. REM: **** r u g  -  report utility generator ****
  91. REM: command lines... ( c$(.) )
  92. REM:   a series of commands, each of which is separated
  93. REM:           by a semicolon;
  94. REM:   line starting with # identifies variable line.
  95. REM:   line starting with $ is special titling line.
  96. REM: commands...
  97. REM:   may be an expression (see below), or:
  98. REM:   c# - print in column  (#=0 to 4, 0=no print)
  99. REM:   z# - clear column total (#=1 to 4)
  100. REM:   t# - print column total (#=1 to 4)
  101. REM:    (z or t may have multiples, e.g., z1234)
  102. REM:   j# - jump to specified line
  103. REM: expressions...
  104. REM:   (parentheses for test)  .. continue line if true (<>0)
  105. REM:   following may be mixed using operators (below)
  106. REM:     numeric values;
  107. REM:     i# for keyboard input (# is column);
  108. REM:     s# for column total   (# is column);
  109. REM:     v# for variable value;
  110. REM:     n   gets yes/no value
  111. REM:  operators (left-to-right evaluation):
  112. REM:   + addition   - subtraction
  113. REM:   * multiply   / divide
  114. REM:   % percentage (multiply)
  115. REM:   [ smaller of      ] greater of
  116. REM:   (example:  22[7 returns 7)
  117. REM:   > < = comparisons:  yield 0 (not true) or 1 (true)
  118. REM:   comparisons may be used multiply, e.g., v5<=100
  119. REM: examples...
  120. REM:      i3+100[500
  121. REM:   input value, add 100, if over 500 set to 500
  122. REM:   print result in column3
  123. REM:      c3;v12%10[100
  124. REM:   take 10% of value 12 (line 12) minimum 100
  125. REM:   and print in column 3
  126. REM:      500;(v15>1000);v15/2
  127. REM:   value 500; or if value 15 is greater than 1000
  128. REM:      set value v15/2.  do not print (no 'c' set).
  129. CLS
  130. PRINT " ."
  131. Ll=0
  132. FOR j=5 TO 6
  133.  FOR k=11 TO 12
  134.   Ll=Ll+POINT(k,j)
  135.  NEXT k
  136. NEXT j
  137. IF Ll=4 THEN Ll=80 ELSE Ll=60
  138. PRINT "Please wait..."
  139. PRINT
  140. PRINT "When prompted, you may enter:"
  141. PRINT "    [RETURN] (for 'zero' input);"
  142. PRINT "    numeric value <return>;"
  143. 'PRINT "    numeric value   +  "
  144. 'PRINT "      (to have items totalled);
  145. PRINT "    [F1][RETURN]   (to review or change data)."
  146. PRINT
  147. PRINT "Ontario 1989 income tax"
  148. PRINT
  149. PRINT "This program does not give tax advice"
  150. PRINT "  ..just helps with the arithmetic."
  151. PRINT
  152. PRINT "This is *not* the computer tax format"
  153. PRINT "accepted for filing by Revenue Canada."
  154. PRINT
  155. PRINT "Some tax calculations call for spouse's income"
  156. PRINT " .. not detailed in this program."
  157. PRINT
  158. DIM i$(200),i%(200),v&(200),c$(200),c%(4),t&(4)
  159. c%(1)=1:c%(2)=2:c%(3)=4:c%(4)=8
  160. READ i$
  161. j=0
  162. WHILE i$<>"end"
  163.  j=j+1
  164.  READ c$
  165.  L0=1
  166.  IF LEFT$(c$,1)="#" THEN
  167.   L0=INSTR(c$,";")
  168.   t=VAL(MID$(c$,2,L0-1))
  169.   IF i%(t)<>0 GOTO LinErr1
  170.   i%(t)=j:L0=L0+1
  171.  END IF
  172.  i$(j)=i$:c$(j)=MID$(c$,L0)
  173.  READ i$
  174. WEND
  175. PRINT
  176. OPEN "scrn:" FOR OUTPUT AS #4
  177. c1=1
  178.     'Next Item
  179. NxLine:
  180.  WHILE c$(c1)<>"" 
  181.  c0=-1:t3=0:c=c1:c1=c1+1
  182.  IF c$(c)="c0" THEN c9=c
  183.  L0=1:L1=LEN(c$(c))
  184.  InptFlg=0
  185.  IF ASC(c$(c))=36 THEN
  186.       ' $ at start of line
  187.   GOSUB BuckLine
  188.  ELSE
  189.   WHILE L0<=L1
  190.    L2=INSTR(MID$(c$(c),L0),";")
  191.    IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  192.    ComdLen=L2-L0
  193.    t=ASC(MID$(c$(c),L0)):IF t>96 THEN t=t-32
  194.    IF t=67 OR (PrtFlg AND t=73) THEN  ' c or i/print
  195.      REM: c - set column value
  196.      c0=VAL(MID$(c$(c),L0+1,ComdLen-1)):e=(c0>4):IF e GOTO LinErr1
  197.      c0=c%(c0)
  198.    ELSEIF t=40 THEN     '  REM (
  199.     REM: (..) evaluate and continue/quit
  200.     e=ASC(MID$(c$(c),L2-1))<>41:IF e GOTO LinErr1
  201.     e=(L2-L0)<3:IF e GOTO LinErr1
  202.     L8=L0+1:L9=L2-1:GOSUB Eval
  203.     IF v#=0 THEN L2=L1  'exit
  204.    ELSEIF t=74 THEN     '  REM j
  205.     REM: j - jump to line
  206.     v=VAL(MID$(c$(c),L0+1,ComdLen-1))
  207.     c1=i%(v)
  208.     L2=L1  'exit
  209.    ELSEIF PrtFlg THEN
  210.     ' pass 2 .. don't calculate
  211.    ELSEIF t=88 THEN     '  REM x
  212.     REM x - table lookup
  213.     y=0:v0#=v&(c)/100#:v#=v0#+1#
  214.     L0=L2+1
  215.     WHILE v#>v0# AND L0<=L1
  216.      y=y+1
  217.      L2=INSTR(MID$(c$(c),L0),";")
  218.      IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  219.      ComdLen=L2-L0
  220.      v#=VAL(MID$(c$(c),L0,ComdLen))
  221.      L0=L2+1
  222.     WEND
  223.     v&(c)=INT(v#*100#+.5#)
  224.     L2=L1    'exit
  225.    ELSEIF t=89 THEN    '  REM y
  226.     REM y - table usage
  227.     y1=0
  228.     L0=L2+1
  229.     WHILE y1<y AND L2<L1
  230.      y1=y1+1
  231.      L2=INSTR(MID$(c$(c),L0),";")
  232.      IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  233.      ComdLen=L2-L0
  234.      v#=VAL(MID$(c$(c),L0,ComdLen))
  235.      L0=L2+1
  236.     WEND
  237.     v&(c)=INT(v#*100#+.5#)
  238.     L2=L1   'exit
  239.    ELSEIF t=84 OR t=90 THEN
  240.       '  T/Z multiple column functions
  241.     c8=c0:c0=0
  242.     FOR j=L0+1 TO L2-1
  243.      t0=VAL(MID$(c$(c),j,1))
  244.      c0=c0 OR c%(t0)
  245.     NEXT j
  246.     IF t=90 THEN
  247.      FOR j=1 TO 4
  248.       IF (c0 AND c%(j))<>0 THEN t&(j)=0
  249.      NEXT j
  250.      c0=c8
  251.     ELSE
  252.      t3=1
  253.     END IF
  254.    ELSE
  255.     GOSUB SeekVal
  256.     IF t0 AND NOT InptFlg THEN
  257.      L8=L0:L9=L2:GOSUB Eval
  258.      IF ASC(RIGHT$(" "+v$,1))=129 GOTO Revise 
  259.     END IF
  260.     IF t0=0 GOTO LinErr0
  261.     v&(c)=INT(v#*100+.5)
  262.    END IF
  263.    L0=L2+1
  264.   WEND
  265.   GOSUB Echo
  266.  END IF
  267. WEND
  268.  
  269. REM: end of control strings
  270. IF PrtFlg=0 THEN
  271.  IF c9=0 GOTO AskPrint
  272.  INPUT "want to revise this";x$
  273.  x$=UCASE$(x$)
  274.  IF x$="Y" OR x$="YES" GOTO Revise
  275. AskPrint: 
  276.  CLOSE 4:INPUT "want a printout";x$
  277.  x$=UCASE$(x$)
  278.  IF x$="Y" OR x$="YES" THEN
  279.   c1=1:OPEN "prt:" FOR OUTPUT AS #4:Ll=80:InptFlg=0:PrtFlg=-1
  280.   GOTO NxLine
  281.  END IF
  282. END IF
  283. PRINT ">>> end <<<"
  284. END
  285.  
  286.    ' revision time
  287. Revise:
  288.  IF c9>0 THEN
  289.   PRINT:r=0
  290.   FOR j=1 TO c9
  291.    IF c$(j)="c0" THEN r=r+1:PRINT r;">>> ";i$(j)
  292.   NEXT j
  293.   r1=1
  294.   IF r>1 THEN
  295.     PRINT "go back to which one (1 to";r;")";
  296.     INPUT r1
  297.   END IF
  298.   IF r1>0 AND r1<=r THEN
  299.    r=0
  300.    FOR j=1 TO c9
  301.     IF c$(j)="c0" THEN r=r+1:IF r=r1 THEN c=j
  302.    NEXT j
  303.   END IF
  304.  END IF
  305.  c1=c:GOTO NxLine
  306.  
  307. LinErr0:
  308.  PRINT "error item";c;"' ";MID$(c$(c),L0);" '":STOP
  309. LinErr1:
  310.  PRINT "error item";c;"' ";MID$(c$(c),L1);" '":STOP
  311. LinErr2:
  312.  PRINT "error item";c;"' ";MID$(c$(c),L8,L5-L8);" '":STOP
  313.  
  314. REM evaluate
  315. Eval:
  316.  v#=0:OpNow=10
  317.  REM get a command
  318.  WHILE L8<L9
  319.   PtOp2=L8:t0=0
  320.   GOSUB SeekOp
  321.   OpNext=t0
  322.   L5=PtOp1
  323.   e=L5<=L8:IF e GOTO LinErr2
  324.   t=ASC(MID$(c$(c),L8))
  325.   IF t>96 THEN t=t-32
  326.   GOSUB SeekVal
  327.   e=t0=0:IF e GOTO LinErr2
  328.   IF (t>47 AND t<58) OR t=46 THEN
  329.    ' Numeric
  330.    v0#=VAL(MID$(c$(c),L8,L5-L8))
  331.   ELSEIF t=83 OR t=86 THEN
  332.    ' S or V
  333.    v1=VAL(MID$(c$(c),L8+1,L5-L8-1))
  334.    IF t=83 THEN v0#=t&(v1)/100#
  335.    IF t=86 THEN
  336.    e=i%(v1)=0
  337.    IF e THEN PRINT "** no param";v1:GOTO LinErr2
  338.    v0#=v&(i%(v1))/100#
  339.    END IF
  340.   ELSEIF t=78 THEN
  341.       '  Y or N
  342.    e=InptFlg:IF e GOTO LinErr2
  343.    REM: y for yes/no
  344.    WINDOW 2,"[Y] or [N]",(10,10)-(400,30),24
  345.    WINDOW OUTPUT 2
  346.    InptFlg=-1
  347.    PRINT i$(c);"(y/n) ";
  348.    INPUT y$:y$=UCASE$(y$)
  349.    WINDOW CLOSE 2
  350.    v0#=0:IF y$="Y" THEN v0#=1
  351.   ELSE
  352.      'Inpt
  353.    e=InptFlg:IF e GOTO LinErr2
  354.    InptFlg=-1
  355.    c0=VAL(MID$(c$(c),L8+1,L5-L8-1))
  356.    e=(c0<1 OR c0>4)
  357.    IF e GOTO LinErr2
  358.    c0=c%(c0)
  359.    IF v&(c)=0 THEN
  360.     WINDOW 2,i$(c),(10,10)-(400,30),24
  361.    ELSE
  362.     GOSUB DolCents:v$=LEFT$(v$,1)+d$
  363.     IF c$<>"00" THEN v$=v$+".":v$=v$+c$
  364.     WINDOW 2,"[RETURN]="+v$,(10,10)-(400,30),24
  365.    END IF
  366.    WINDOW OUTPUT 2
  367.    PRINT i$(c);"? ";
  368.    LINE INPUT v$
  369.    IF v$<>"" THEN
  370.     v0#=VAL(v$)
  371.    ELSE
  372.     v0#=v&(c)/100#
  373.    END IF
  374.    WINDOW CLOSE 2
  375.    IF ASC(RIGHT$(" "+v$,1))=129 THEN RETURN
  376.   END IF
  377.   '  perform dyadic operation
  378.   ON OpNow GOSUB lt,eq,le,gr,ne,ge,br,pct,ml,ad,sb,div,flr,cei
  379.   OpNow=OpNext:L8=PtOp2
  380.  WEND
  381. RETURN
  382.  
  383. ad: v#=v#+v0#
  384.     RETURN
  385. sb: v#=v#-v0#
  386.     RETURN
  387. ml: v#=v#*v0#
  388.     RETURN
  389. div: v#=v#/v0#
  390.     RETURN
  391. pct: v#=v#*v0#/100#
  392.     RETURN
  393. flr: IF v#>v0# THEN v#=v0#
  394.     RETURN
  395. cei: IF v#<v0# THEN v#=v0#
  396.     RETURN
  397. lt: v#=-(v#<v0#)
  398.     RETURN
  399. eq: v#=-(v#=v0#)
  400.     RETURN
  401. le: v#=-(v#<=v0#)
  402.     RETURN
  403. gr: v#=-(v#>v0#)
  404.     RETURN
  405. ne: v#=-(v#<>0#)
  406.     RETURN
  407. ge: v#=-(v#>=0#)
  408.     RETURN
  409. br: v#=1
  410.     RETURN
  411.  
  412. Echo:
  413.  IF c0>=0 THEN
  414.   PRINT#4,LEFT$(i$(c)+SPACE$(21),21);" ";
  415.    IF c0>=1 THEN
  416.     FOR j=1 TO 4
  417.      IF (c0 AND c%(j))=0 THEN
  418.       IF Ll>60 OR j<>1 THEN PRINT#4,SPACE$(12);
  419.      ELSE
  420.       IF t3=0 THEN
  421.        t&(j)=t&(j)+v&(c)
  422.       ELSE
  423.        v&(c)=t&(j):t&(j)=0
  424.       END IF
  425.       GOSUB DolCents
  426.       cr$="  ":IF LEFT$(v$,1)="-" THEN cr$="cr"
  427.       d$=RIGHT$(SPACE$(6)+d$,6):cm$=MID$(d$,3,1)
  428.       IF cm$<>" " THEN cm$=","
  429.       PRINT#4,LEFT$(d$,3);cm$;MID$(d$,4);".";c$;cr$;
  430.      END IF
  431.     NEXT j
  432.    END IF 
  433.    PRINT#4,
  434.   END IF
  435. RETURN
  436.  
  437. DolCents:
  438.  v$=STR$(v&(c)):IF LEN(v$)<3 THEN v$=LEFT$(v$,1)+"0"+RIGHT$(v$,1)
  439.  c$=RIGHT$(v$,2):d$=MID$(v$,2,LEN(v$)-3)
  440.  IF LEN(d$)>6 THEN d$="******"
  441. RETURN
  442.  
  443.  REM: dollars line
  444. BuckLine:
  445.  PRINT#4,LEFT$(i$(c)+SPACE$(21),21);" ";
  446.  L0=2
  447. WHILE L0<=L1
  448.  L2=INSTR(MID$(c$(c),L0),";")
  449.  IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  450.  ComdLen=L2-L0
  451.  IF L2>0 THEN PRINT#4,RIGHT$(SPACE$(10)+MID$(c$(c),L0,ComdLen),10);"  ";
  452.  IF L2=0 THEN PRINT#4,SPACE$(12);
  453.  L0=L2+1
  454. WEND
  455.  PRINT#4,
  456. RETURN
  457.  
  458.       ' value types
  459. SeekVal:
  460.  t0=INSTR("0123456789.IVSN",CHR$(t))
  461. RETURN
  462.       ' operators and comparison groups
  463. SeekOp:
  464.   PtOp1=0
  465.   t0=0
  466.   t2=0
  467.  WHILE PtOp2<L9 AND ((t0=0 AND PtOp1=0) OR (t0<>0 AND PtOp1<>0))
  468.   PtOp2=PtOp2+1
  469.   t1=t0
  470.   t0=INSTR("<==>===%*+-/[]",MID$(c$(c),PtOp2,1))
  471.   t2=t2 OR t0
  472.   IF t0<>0 AND PtOp1=0 THEN PtOp1=PtOp2
  473.  WEND
  474.  IF t1=t2 THEN
  475.   t0=t1
  476.  ELSE
  477.   IF t2<8 THEN t0=t2
  478.  END IF
  479.  IF PtOp1=0 THEN PtOp1=L9
  480. RETURN
  481. END
  482.